home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 011 / asysend.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-06-03  |  2.4 KB  |  71 lines
  1. (*----------------------------------------------------------------------*)
  2. (*          Async_Send --- Send character over communications port      *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. Procedure Async_Send( C : Char );
  6.  
  7. (*                                                                      *)
  8. (*     Procedure:  Async_Send                                           *)
  9. (*                                                                      *)
  10. (*     Purpose:    Sends character out over communications port         *)
  11. (*                                                                      *)
  12. (*     Calling Sequence:                                                *)
  13. (*                                                                      *)
  14. (*        Async_Send( C : Char );                                       *)
  15. (*                                                                      *)
  16. (*           C --- Character to send                                    *)
  17. (*                                                                      *)
  18. (*     Calls:  None                                                     *)
  19. (*                                                                      *)
  20.  
  21. Var
  22.    i       : Integer;
  23.    m       : Integer;
  24.    Counter : Integer;
  25.  
  26. Begin   (* Async_Send *)
  27.  
  28.                    (* Turn on OUT2, DTR, and RTS *)
  29.  
  30.    Port[UART_MCR + Async_Base] := $0B;
  31.  
  32.                    (* Wait for CTS using Busy Wait *)
  33.  
  34.    Counter := MaxInt;
  35.  
  36.    While ( Counter <> 0 ) AND
  37.          ( ( Port[UART_MSR + Async_Base] AND $10 ) = 0 ) Do
  38.       Counter := Counter - 1;
  39.  
  40.                    (* Wait for Transmit Hold Register Empty (THRE) *)
  41.  
  42.    If Counter <> 0 Then Counter := MaxInt;
  43.  
  44.    While ( Counter <> 0 ) AND
  45.          ( ( Port[UART_LSR + Async_Base] AND $20 ) = 0 ) Do
  46.       Counter := Counter - 1;
  47.  
  48.                    (* Send the character if port clear *)
  49.  
  50.   If Counter <> 0 Then
  51.      Begin  (* Send the Character *)
  52.  
  53.         Inline($FA); (* CLI --- disable interrupts *)
  54.  
  55.         Port[UART_THR + Async_Base] := Ord(C);
  56.  
  57.         Inline($FB); (* STI --- enable interrupts *)
  58.  
  59.      End    (* Send the Character *)
  60.  
  61.   Else  (* Timed Out *)
  62.      Writeln('<<<TIMEOUT>>>');
  63.  
  64. End    (* Async_Send *);
  65. 
  66.      End    (* Send the Character *)
  67.  
  68.   Else  (* Timed Out *)
  69.      Writeln('<<<TIMEOUT>>>');
  70.  
  71. End    (